Loadstar Extras 3/Ex3side2.d64/iprg2 source

Text File | 2022-08-28 | 20KB | 1,828 lines

open =$ffc0
readst =$ffb7
setlfs =$ffba
setnam =$ffbd
setmsg =$ff90
load =$ffd5
getin =$ffe4
input'buffer =512
clrchn =$ffcc
close =$ffc3   ;a
chrin =$ffcf
chkout =$ffc9  ;x
chkin =$ffc6   ;x
plot =$fff0
chrout =$ffd2
color'pointer =243
screen'line'pointer =209
print'number =$bdcd ;x,a
clear'line =59903
background =53281
border =53280
strout = $ab1e; .A low .Y high
unlisten =$ffae
clall =$ffe7
color1 =53282
color2 =53283
color3 =53284
white =5
crsr'down =17
rvs'on =18
home =19
del =20
red =28
crsr'right =29
green =30
blue =31
black =144
lowercase =14
uppercase =142
crsr'up =145
rvs'off =146
clr =147
insert =148
brown =149
light'red =150
dark'grey =151
medium'grey =152
light'green =153
light'blue =154
light'grey =155
purple =156
crsr'left =157
yellow =158
cyan =159
top'left =176
top'right =174
bottom'left =173
bottom'right =189
error'string =$200
buffer =$200

swap'source =251
swap'end =253
swap'destination =$14

.org $0800
.obj "@0:iprg2 0800"
;mem

jmp do'page
jmp add'item;3
jmp add'description;6
jmp alter'font;9
jmp add'title;12
jmp change'colors;15
jmp change'report;18
jmp menu'entry;21
jmp box'entry;24
jmp screen'stash;27
jmp screen'restore;30
jmp linx;33
jmp print'at;36
jmp center;39
jmp ucase;42
jmp lcase;45
jmp brancher;48
jmp input'dir;51;
jmp input'any;54
jmp get'word;57;
jmp read'block;60
jmp write'block;63
jmp write'range;66
jmp get'blox;69
jmp swappymem; copymem 72
jmp swappymem+7;swappymem 75
jmp swappymem+14;copy with roms on 78
jmp reverse'entry; 81
;sys source,end+1,dest
;copy =addr
;swap =addr+7
;ROM in copy =addr+14
;sys,addr y,x1,x2,number items,text,highlight,hot$

;***sys addr,x,to x,y,to y,s-code,color

box'entry lda #0
sta temp
- jsr get'number
tya
ldy temp
sta box'parameters,y
inc temp
cpy #5
bne -

fill'box jsr linx
lda 214
pha
lda 211
pha
box'start ldx box'parameters+2
ldy #0
clc
jsr $fff0
jsr old'rom'patch
dec box'parameters
;inc box'parameters+3

- ldy box'parameters+1
- lda box'parameters+5
cmp #16
bcs +
lda box'parameters+4
sta (209),y
+ lda box'parameters+5
sta (243),y
dey
cpy box'parameters
bne -
lda 214
cmp box'parameters+3
beq +

inc 214
jsr 58732
jsr old'rom'patch
jmp --
+ lda #home
jsr $ffd2
pla
sta 211
pla
sta 214
jmp 58732

linx ldy #24
- lda 217,y
ora #128
sta 217,y
dey
bpl -
rts

screen'stash sec
jsr plot
stx menuy
sty menux1

jsr get'number
tya
sta 252
cmp >1024
bcs +
rts

+ clc
adc #4
sta 254
lda #0
sta 253
sta 251

lda #home
jsr chrout
jsr old'rom'patch
sei
lda #0
sta 1

ldx #3
ldy #0
- lda (209),y
sta (251),y
dec 1
lda (243),y
inc 1
sta (253),y
iny
bne -
inc 210
inc 252
inc 244
inc 254
dex
bpl -
dec 254
ldy #233
dec 1
lda 53280
inc 1
sta (253),y
iny
dec 1
lda 53281
inc 1
sta (253),y
iny
lda menuy
sta (253),y
iny
lda menux1
sta (253),y
lda #$77
sta 1
cli
ldy menux1
ldx menuy
clc
jmp plot

screen'restore jsr get'number
tya
sta 252
clc
adc #4
sta 254
lda #0
sta 253
sta 251

lda #home
jsr chrout
jsr old'rom'patch
sei
lda #0
sta 1

ldx #3
ldy #0

- lda (251),y
sta (209),y
lda (253),y
dec 1
sta (243),y
inc 1
iny
bne -
inc 210
inc 252
inc 244
inc 254
dex
bpl -
dec 254
ldy #233
lda (253),y
dec 1
sta 53280
iny
inc 1
lda (253),y
dec 1
sta 53281
inc 1
iny
lda (253),y
sta 214
iny
lda (253),y
sta 211
lda #$77
sta 1
cli
jmp 58732

menu'entry lda #0
sta temp
sta flag
- jsr get'number
tya
ldy temp
sta menuy,y
inc temp
cpy #5
bne -

menu jsr get'string
sta key
ldy #0
- lda ($22),y
sta keybuff,y
iny
cpy key
bcc -
lda key
clc
adc #3
sta key
lda <allowed'keys
sta $22
lda >allowed'keys
sta $23

jsr linx
ldx menuy
ldy #0
sty menu'current
clc
jsr plot
jsr old'rom'patch
lda menu'highlight
sta mcolor
jsr paint'line

menu'wait jsr branch2
ldx menu'current
stx temp
pha
jsr normalize'line
pla

cmp #2
beq menu'down

cmp #1
beq menu'up

cmp #3
beq menu'select

cmp #4
bcc menu'wait
sec
sbc #4
sta menu'current
jmp menu'select

menu'wait'loop jmp menu'wait

menu'down inc menu'current
lda menu'current
cmp menu'items
bne highlight
lda #0
sta menu'current
jmp highlight

menu'up dec menu'current
lda menu'current
cmp #255
beq +
jmp highlight

+ ldy menu'items
dey
sty menu'current
jmp highlight

menu'select jsr normalize'line
lda menu'current
clc
adc #1
jmp do'report

normalize'line lda menu'current
cmp menu'items
bcc +
rts

+ clc
adc menuy
tax
ldy #0
jsr plot
jsr old'rom'patch
lda menu'text
sta mcolor
jmp paint'line

highlight lda menuy
clc
adc menu'current
tax
ldy #0
clc
jsr plot
jsr old'rom'patch
lda menu'highlight
sta mcolor
jsr paint'line
jmp menu'wait

paint'line ldy menux1
- lda mcolor
sta (243),y
bmi +
lda (209),y
eor #128
sta (209),y
+ iny
cpy menux2
beq -
bcc -
lda temp
pha
jsr print'info
pla
sta temp
rts

;**** get number from BASIC ****

get'number jsr $aefd
jsr $ad8a
jsr $b7f7
rts


;***** get string from BASIC ****

get'string jsr $aefd
jsr $ad9e
jsr $b6a3

ldx $22
ldy $23
rts

print'at jsr linx
jsr get'number
sty 211
jsr get'number
sty 214
jsr 58732
jsr get'string
sta temp

print'string ldy #0
- lda ($22),y
jsr chrout
iny
cpy temp
bne -
rts

ucase jsr get'string
sta temp
ldy #0
- lda ($22),y
cmp #65
bcc +
ora #128
sta ($22),y
+ iny
cpy temp
bne -
rts

lcase jsr get'string
sta temp
ldy #0
- lda ($22),y
and #127
sta ($22),y
iny
cpy temp
bne -
rts

center jsr get'number
tya
tax
ldy #0
clc
jsr plot

jsr get'string
sta temp

lsr
sta flag
lda #20
sec
sbc flag
sta 211
jsr 58732
jmp print'string

old'rom'patch lda 210
sec
sbc 648
clc
adc #$d8
sta 244
lda 209
sta 243
rts

do'box stx 251
sty 252
ldy #5
- lda (251),y
sta box'parameters,y
dey
bpl -
jmp fill'box

do'menu stx 251
sty 252
ldy #6
- lda (251),y
sta menuy,y
dey
bpl -
jmp menu

do'page ldy border'color
sty 53280
ldy background'color
sty 53281

jsr get'number
sty features
jsr find'longest

lda longest
clc
adc #2
lsr
sta temp
lda #19
sec
sbc temp
sta middle'shadow
sta middle
clc
adc longest
adc #2
sta middle'shadow+1
sta middle+1
inc middle
inc middle+1
lda backdrop+5
and #127
tay
lda shades,y
ora #128
sta middle'shadow+5
sta title'shadow+5

lda features
lsr
clc
adc #2
sta temp
lda #15
sec
sbc temp
sta middle+2
sta middle'shadow+2
inc middle'shadow+2
clc
adc features
clc
adc #1
sta middle+3
sta middle'shadow+3
inc middle'shadow+3

ldx <backdrop
ldy >backdrop
jsr do'box

ldx <title'shadow
ldy >title'shadow
jsr do'box

ldx <title
ldy >title
jsr do'box

ldx <middle'shadow
ldy >middle'shadow
jsr do'box

ldx <middle
ldy >middle
jsr do'box

ldx <bottom
ldy >bottom
jsr do'box

lda #1
sta 255

- lda 255
clc
adc middle+2
tax
ldy middle
iny

clc
jsr plot
lda middle+5
sta 646
lda middle+4
and #128
sta 199
lda 255
jsr index'item
ldy #0
- lda (251),y
beq +
jsr chrout
iny
bne -
+ inc 255
lda 255
cmp features
bcc --
beq --

ldy middle+2
iny
sty page'parameters
lda middle
sta page'parameters+1
lda middle+1
sta page'parameters+2
lda features
sta page'parameters+3
lda middle+5
;ora #128
sta page'parameters+4
lda title+5
;ora #128
sta page'parameters+5
lda middle+5
sta page'parameters+6

lda #0
sta 199

lda bottom+5
sta 646

ldx #24
ldy #8
clc
jsr plot

lda <bottom'message
ldy >bottom'message
jsr strout

jsr print'title

ldx <page'parameters
ldy >page'parameters
jsr do'menu


rts


add'item lda <menu'slots
sta 251
lda >menu'slots
sta 252
alt'add jsr get'number
alt'item tya
sta temp
asl
clc
adc temp
clc
adc 251
sta 251
lda #0
adc 252
sta 252

jsr get'string
ldy #2
sta (251),y
lda $23
dey
sta (251),y
lda $22
dey
sta (251),y
rts

add'description lda <descriptions
sta 251
lda >descriptions
sta 252
jmp alt'add

index'item pha
lda <menu'slots
sta 253
lda >menu'slots
sta 254
alt'index pla
sta temp
asl
clc
adc temp
clc
adc 253
sta 253
lda #0
adc 254
sta 254

ldy #0
lda (253),y
sta 251
iny
lda (253),y
sta 252
iny
lda (253),y
sta wlength
rts

index'description pha
lda <descriptions
sta 253
lda >descriptions
sta 254
jmp alt'index

find'longest lda #1
sta 255
lda #0
sta longest

- lda 255
jsr index'item
lda wlength
cmp longest
bcc +
sta longest
+ inc 255
lda 255
cmp features
bcc -
beq -
rts

print'title lda #0
jsr index'item

lda wlength
lsr
sta temp+1
lda #20
sec
sbc temp+1
tay
ldx #3
clc
jsr plot

lda #1
sta 199
lda title+5
sta 646

ldy #0
- lda (251),y
jsr chrout
iny
cpy wlength
bne -
rts

print'info ldy menu'current
cpy #10
bcc +
rts
+ iny
tya
jsr index'description
lda wlength
bne +
rts

+ ldx <b